home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / comm / cnet / cnet_pager.lha / doors / pager / PagerChat < prev    next >
Encoding:
Text File  |  1998-03-15  |  11.1 KB  |  268 lines
  1. /**************************************************************************\
  2.          $VER: CNet PagerChat, v5.20 (15-Mar-98) by Dotoran!
  3. \**************************************************************************/
  4. options results;signal on SYNTAX;signal on ERROR;signal on IOERR
  5. a=sourceline(2);parse var a . ", "ver" ("vdate")" .;a=random(,,time("s"))
  6. tr=transmit;se=sendstring;gc=getchar;gu=getuser;pu=putuser
  7. parse source . . fp .;df=left(fp,max(lastpos('/',fp),lastpos(':',fp)))
  8.  
  9. gu 15;access=result
  10. a=time("n");b=left(a,2)*60+substr(a,4,2);a=getclip("PagerWindow")
  11. if a>"" then if b>=a+5 then se "#0"df"PagerCleanUp}"
  12.  
  13. /*           check;        check100; HiPort;                                    */
  14. /*   3Port0  4Port0  3Ports  4Ports  3HiPort 4HiPort <-- CNet3/4.45 Specific    */
  15. dat="2121864 2124654 2124264 2127054 2225094 2227884"
  16. bbsidentify bbs;a=word(result,3);cnet=(datatype(left(a,4),"n")=1&a>"4.44")+3
  17. guPORT0=word(dat,(cnet=4)+1) ; guPORTS=word(dat,(cnet=4)+3)
  18. guHIPORT=word(dat,(cnet=4)+5)
  19.  
  20. call READCONFIG;call READGROUP;gu 1;handle=result;gu 3;name=result;gu 40;uid=result
  21. gu 27;cols=result;gu 7;time=result%10;gu 23;port=result;user=handle" ("name")"
  22. gu 2400088;max=result;gu 1500000;file="Out."left(result,3)
  23. gu 1100003;line=result+1;gu 2307386;epath=result /* Editor Temp Path (3.05c & 4.45) */
  24.  
  25. call open(f1,df||file,"r")
  26.   do line ; out=readln(f1) ; end
  27. call close(f1)
  28.  
  29. if out="" then do
  30.   call open(f1,df"Out.Def","r");out=readln(f1);call close(f1);end
  31.  
  32. if out="" then out="not available for chatting."
  33.  
  34. pn="He he his She she her"
  35.  
  36. if multi=1 then do
  37.  
  38.   if cols<78 | gra=0 then do
  39.     tr "f1n3cbCNet ceAmiga cbPagerc6, cf"ver"c6!n1"
  40.     tr "z4ce  Available SysOps  z0n1"
  41.     do i=1 to mtot
  42.       tr "cb"right(i,2)"c6> ca"sys.i
  43.     end i
  44.     se "n1cfPage c6Which: cai64 2}" ; gu 70 ; a=result
  45.     if a<1 | a>mtot then a=1
  46.   end
  47.  
  48.   if cols>78 & gra=1 then do ; row=(20-mtot)%2
  49.     tr "f1"row-2";30HcbCNet ceAmiga cbPagerc6, cf"ver"c6!ce"
  50.     tr ""row";30Hz4    Available SysOps    z0"
  51.     do i=1 to mtot
  52.       tr ""row+i";30Hz4  z0ca"center(sys.i,20)"z4  z0"
  53.     end i
  54.     tr ""row+i";30Hz4                        z0"
  55.     tr ""row+i+1";32HcdArrows ceSelect cfSysOpc6,"
  56.     tr ""row+i+2";32HccENTER caCreates cbPagec6.s"
  57.     r=1
  58.     do until c2d(a)=13
  59.       se ""row+r";32Hc9"center(sys.r,20)"u"
  60.       gc ; a=result ; call CHECK
  61.       if c2d(a)=27 then do 2 ; gc ; a=result ; end
  62.       if a="A" | a="D" then do
  63.         se ""row+r";32Hca"center(sys.r,20)
  64.         r=r-1 ; if r=0 then r=mtot ; end
  65.       if a="B" | a="C" then do
  66.         se ""row+r";32Hca"center(sys.r,20)
  67.         r=r+1 ; if r>mtot then r=1 ; end
  68.     end ; a=r
  69.   end
  70.  
  71. end
  72.  
  73. else a=1
  74.  
  75. sysopname=sys.a ; ge=ge.a ; po=pos.a ; id=id.a ; if ge=0 then ge=2
  76. sysop=a;p1=subword(pn,ge*3-2,1);p2=subword(pn,ge*3-1,1)
  77. p3=subword(pn,ge*3,1) ; call PARSE(ac,31)
  78.  
  79. if handle=sysopname & handle~="Dotoran" then do
  80.   se "n2c6You want to caPAGE ceyourself cd"sysopname
  81.   tr "c6? I c9don't c6think so..." ; exit ; end
  82.  
  83. z=getclip("Pager"port)
  84. if z="" then do ; z=0 ; call setclip("Pager"port,z) ; end
  85.  
  86. if find(it.0,access)=0 & z=cb+1 then do
  87.   se "n2c6You've cfpaged cd"sysopname"c6 the c9maximum c6number "
  88.   tr "of times! If "p2"'s around, "p2"'ll caanswerc6..." ; exit ; end
  89.  
  90. tr "n2c6Enter A cbReason c6for Paging ca"sysopname"c6."
  91.   gu 1100661 ; cancc=PRIV(0,14) /* Can user use "CC" command? */
  92.  
  93. se "cf: cei144 35}s" ; gu 70 ; reason=result ; call CHECK
  94.   if reason="" then do ; tr "uc9Abort" ; exit ; end
  95.  
  96. if getclip("PagerWindow")~="" then do
  97.   se "n1c6A cbPager ceWindow c6is already c9active c6on cd"
  98.   tr sysopname"'s c6screen." ; exit ; end
  99.  
  100. gu 12 ; date=result
  101. if cc=1 & cancc=1 then do
  102.   gu guHIPORT ; aa=result
  103.   online=-1 ; call PARSE(pos.a,aa)
  104.   do i=1 to words(it.0) ; getportid word(it.0,i) ; aa=result
  105.     if aa=-1 | aa~=id then iterate i
  106.     if aa=id then do ; online=word(it.0,i) ; leave i ; end
  107.   end i
  108.   if online>-1 then do
  109.     se "n1cd"sysopname" c6is caalready c6signed onto cfPort "
  110.     tr online"c6! Sending a ceChat Request c6now..."
  111.     addkeys ("CC"online"!`"reason"`") ; exit ; end
  112. end
  113.  
  114. setobject reason ; pu 1307274 /* Current Chat Message (3.05c & 4.45) */
  115. gu 1100729 ; page=result /* May Page The SysOp Priv.  (3.05c & 4.45) */
  116.  
  117. gu guPORT0+port*24            /* check; */
  118. CanChat=BitTST(d2c(result),4) /* Checkmark next to "Sysop is in"? */
  119.  
  120. gu guPORTS                       /* check Global Ports setting */
  121. CanChatALL=BitTST(d2c(result),4) /* Checkmark next to "Sysop is in" Globally? */
  122.  
  123. if page=2 | (page=0 & (CanChat=1 | CanChatALL=1)) then do
  124.   paged=1 ; call CHATLOG
  125.   call open(f1,"ram:chat."port,"W")
  126.     call writeln(f1,uid)
  127.     call writeln(f1,user)
  128.     call writeln(f1,reason)
  129.     call writeln(f1,sysopname)
  130.     call writeln(f1,time)
  131.     call writeln(f1,sysop)
  132.   call close(f1)
  133.   se "n1c6Now c9Paging ca"sysopname"c6....n1"
  134.   address command "run >nil: rx "df"Pager "port" "cnet
  135.   aa="º ºC³ ³"
  136.  
  137.   if gra=0 then tr "n1cfPaging cb"sysopname"cf..."
  138.  
  139.   if cols>78 & gra=1 then do ; gu 12 ; date=result
  140.     date=translate("HIJ. EF, LMNO (QRSTUVm)",date,"ABCDEFGHIJKLMNOPQRSTUV")
  141.     if substr(date,21,1)=" " then date=delstr(date,21,2)
  142.     if substr(date,16,1)=" " then date=delstr(date,16,1)
  143.     tr "f1n1"center("cdA window similar to this one appeared on ce"sysopname"'s cdscreen:",88)
  144.     tr "ccÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍce¿ "
  145.     tr "ccºCcfCNet Amiga Pager, "ver" Written by Dotoran!CceÀÄ´"
  146.     tr "ccº ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍce¿ ³"
  147.     tr "ccº ºCcbPagec9: cd"left(date" c6for cb"sysopname,61)" ce³ ³"
  148.     tr "ccº ºCce³ ³"
  149.     tr "ccº ºCcbUserc9: ca"left(handle" cf(ce"name"cf) c6Port ca"port,71)"ce³ ³"
  150.     tr "ccº ºCce³ ³"
  151.     tr "ccº ºCcbReasonc9: cf`cd"left(reason"cf'",58)"ce³ ³"
  152.     tr "ccº ÓceÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³"
  153.     tr "ccº ÉÍÍÍÍce¿ ccÉÍÍÍce¿ ccÉÍÍÍÍÍce¿ ccÉÍÍÍÍÍÍÍÍÍce¿ ccÉÍÍÍÍÍÍÍÍÍce¿ ccÉÍÍÍÍÍÍÍÍÍÍÍce¿ ccÉÍÍÍÍce¿ ccÉÍÍÍÍÍÍce¿ ³"
  154.     tr "ccº ºcfChatce³ ccºcfOLMce³ ccºcfFSendce³ ccºcfTerminatece³ ccºcfGone In 5ce³ ccºcfUnavailablece³ ccºcfBusyce³ ccºcfo1Ignoreo0ce³ ³"
  155.     tr "ccº ÓceÍÄÄÄÙ ccÓceÍÄÄÙ ccÓceÍÄÄÄÄÙ ccÓceÍÄÄÄÄÄÄÄÄÙ ccÓceÍÄÄÄÄÄÄÄÄÙ ccÓceÍÄÄÄÄÄÄÄÄÄÄÙ ccÓceÍÄÄÄÙ ccÓceÄÄÄÄÄÄÙ ³"
  156.     tr "ccÓceÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ"
  157.     tr "   cdIf "p2" should press an underlined button, you'll receive an cbOLM cdMessage!"
  158.   end
  159.  
  160.   if cols<78 | gra=0 then do
  161.     tr "n1ca"sysopname" c6has been notified that you wish to chat. "
  162.     tr "n1"p1" ceMay c6or ceMay c9NOT c6be around."
  163.     tr "n1"p1" will cdAnswer c6if "p2" is available."
  164.     tr "n1cbONE c9Page c6is caENOUGHc6."
  165.     se "n1A window telling ca"sysopname"c6 that someone has "
  166.     tr "c9Paged c6stays on "p3" screen."
  167.   end
  168.  
  169. end
  170.  
  171. else do
  172.   se "n1c9Sorryc6, ca"sysopname" c6isn't around right now.n2"
  173.   if sysop=1 then tr p1"'s "out"n1"
  174.   se "c6Leave cbMail c6for ca"sysopname
  175.   se "c6? c7[caYesc7]c6: ca" ; gc ; z=result
  176.   if z="N" then do ; tr "No." ; paged=0 ; call CHATLOG ; exit ; end
  177.   tr "Yes!" ; setmailsubj strip(left(reason,30)) ; cleareditor
  178.   paged=2 ; call CHATLOG ; tr "n1c6Mail Subjectc9: ca"left(reason,30)
  179.   calleditor 0 ; gu 1109865 ; st=result /* edbuff status (3.05c & 4.45) */
  180.   if st=1 then call PARSE(mid.a,max)
  181.   if words(it.0)=1 & st=1 then do
  182.     setobject "" ; pu 1307274 /* Current Chat Message. (3.05c & 4.45) */
  183.     se "cbSaving c6Mail..." ; writemail id ; tr "cdDonec6!" ; exit ; end
  184.   if st=0 then do
  185.     tr "c9Empty Editor" ; exit ; end
  186.   if st=-1 then do ; tr "c9Aborted Editor" ; exit ; end
  187.   line.0="caUser c6initially cfpagedc9: cd"sys.a"n1"
  188.   lin.0 ="n1c6This camessage c6sent toc9:cbn1"
  189.   do i=1 to words(it.0)
  190.     id=word(it.0,i) ; loadscratch id ; savescratch (-id)
  191.     getscratch 1 ; han=result ; lin.i=">5cd"han
  192.   end i
  193.   call open(f1,epath"_edbuff"port,"r")
  194.     do i=1 until eof(f1) ; line.i=readln(f1) ; end i
  195.   call close(f1)
  196.   call open(f1,epath"_edbuff"port,"w")
  197.     do j=0 to i-1 ; call writeln(f1,line.j) ; end j
  198.     do i=0 to words(it.0) ; call writeln(f1,lin.i) ; end i
  199.   call close(f1)
  200.   address command "copy "epath"_edbuff"port" "epath"_edbuf"port
  201.   do i=1 to words(it.0)
  202.     id=word(it.0,i) ; loadscratch id ; savescratch (-id)
  203.     getscratch 1 ; han=result ; se "cbSending c6to...ca"han"c6..."
  204.     setmailsubj strip(left(reason,30)) ; writemail id
  205.     address command "copy "epath"_edbuf"port" "epath"_edbuff"port
  206.     tr "cdSentc6!"
  207.   end i ; setobject "" ; pu 1307274 /* Chat Message. (3.05c & 4.45) */
  208.   address command "delete "epath"_edbuf"port
  209. end
  210.  
  211. exit
  212.  
  213. READCONFIG:
  214.   call open(f1,df"PagerConfigF","r")
  215.     a=readln(f1);parse var a gra"|"cc"|"cb"|"ac"|"hr"|"j
  216.     a=readln(f1);parse var a fpath"|"cost"|"kill"|"j
  217.     a=readln(f1);parse var a chsp"|"chvo"|"j
  218.     a=readln(f1);parse var a font"|"size"|"logN"|"logK"|"j
  219.     a=readln(f1);parse var a mtot"|"grp1"|"sys1"|"grp2"|"sys2"|",
  220.                              grp3"|"sys3"|"grp4"|"sys4"|"j
  221.     do i=1 to mtot;sysop.i=readln(f1);end i;if mtot>1 then multi=1
  222.   call close(f1)
  223.  return
  224.  
  225. READGROUP:
  226.   call PARSE(grp1,31);if find(it.0,access)>0 then do
  227.     call PARSE(sys1,mtot);signal GETSYSOPS;end
  228.   call PARSE(grp2,31);if find(it.0,access)>0 then do
  229.     call PARSE(sys2,mtot);signal GETSYSOPS;end
  230.   call PARSE(grp3,31);if find(it.0,access)>0 then do
  231.     call PARSE(sys3,mtot);signal GETSYSOPS;end
  232.   call PARSE(grp4,31);if find(it.0,access)>0 then do
  233.     call PARSE(sys4,mtot);signal GETSYSOPS;end
  234.  
  235. GETSYSOPS:
  236.   do i=1 to c;a=it.i
  237.     parse var sysop.a id.i"|"sys.i"|"ge.i"|"mid.i"|"pos.i"|"snd.i"|",
  238.                       say.i"|"j
  239.   end i;mtot=c
  240.  return
  241.  
  242. CHATLOG:
  243.   call open(f1,"sysdata:log/"logN||id,substr("wa",exists("sysdata:log/"logN||id)+1,1))
  244.     call writeln(f1,"ca"left(handle,25)"cd"date()"  cb"left(reason,39)"ce"substr("NYM",paged+1,1))
  245.   call close(f1);return
  246.  
  247. PARSE:;it.="";c=0;it=translate(arg(1),"  ",".,")
  248.   do z=1 to words(it);c=c+1;it.c=word(it,z)
  249.   if index(it.c,"-")>0 then do;parse var it.c x"-"y
  250.   if y="" then y=arg(2);if x="" then x=0;if x>y then do;d=x;x=y;y=d;end
  251.   do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  252.   else if it.c>arg(2) | it.c<0 then do;c=c-1;iterate;end;end
  253.   do i=1 to c;it.0=it.0||it.i" ";end;return c
  254.  
  255. PRIV:;gu 1400660+(44*Arg(1));aa=reverse(d2c(result,4));do i=2 to Arg()
  256.   if ~BitTST(aa,Arg(i)) then return 0;end i;return 1
  257.  
  258. CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
  259.   getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
  260.   logentry "Lost Carrier!!";bufferflush;exit
  261. SYNTAX:;ERROR:;IOERR:;e1="n1 Error: "rc" ("errortext(rc)")"
  262.   e2="  Line: "left(sigl,4)"File:";c="`"fp", "ver"'";e2=e2" "c;tr e1;tr e2
  263.   logentry e1;logentry e2;e=strip(translate(sourceline(sigl),"\{",""))
  264.   do while e~="";e3="Source: "left(e,37);tr e3;logentry e3;e=substr(e,38);end
  265.   bufferflush
  266. /**************************************************************************\
  267. \****************************************** Frontiers BBS (716)/823-9892 **/
  268.